Cream of the Crop 1/Cream of the Crop 1.iso/MONITOR/TOPOGRAF.ARJ/TOPOGRAF.BAS

BASIC Source File | 1992-03-21 | 5KB | 236 lines

    DEFINT A-Z
    BLUINC& = 65536
    GRNINC = 256
    REDINC = 1
    PALETTE
    OPTION BASE 1

    RANDOMIZE TIMER

    INPUT.DATA$ = "00000"

    DO

        FIRST.FILE$ = ""
        FIRST.FILE$ = COMMAND$
        IF LEN(FIRST.FILE$) < 8 THEN
            FIRST.FILE$ = "30091.30S"
        END IF

    LOOP WHILE INSTR(FIRST.FILE$, ".30S") = 0

    COLOR 7, 1
    CLS
    COLOR 15, 1

    INPUT.LAT% = VAL(LEFT$(FIRST.FILE$, 2))
    INPUT.LONG% = VAL(MID$(FIRST.FILE$, 3, 3))

    MIN.VAL% = 25000
    MAX.VAL% = 0

    FOR LATITUDE% = INPUT.LAT% TO (INPUT.LAT% + 1)

        FOR LONGITUDE% = (INPUT.LONG% - 2) TO INPUT.LONG%

            FILE.LAT$ = LTRIM$(STR$(LATITUDE%))
            FILE.LONG$ = LTRIM$(STR$(LONGITUDE%))

            IF LONGITUDE% < 10 THEN
                FILE.LONG$ = "0" + FILE.LONG$
            END IF
            IF LONGITUDE% < 100 THEN
                FILE.LONG$ = "0" + FILE.LONG$
            END IF
            INPUT.FILE$ = FILE.LAT$ + FILE.LONG$ + ".30S"

            OPEN INPUT.FILE$ FOR BINARY AS #1

            LOCATE 10, 20
            PRINT SPACE$(32)
            LOCATE 10, 20
            PRINT " READING DATA-FILE : "; INPUT.FILE$; " "

            DO
                GOSUB KEYCHECK

                GET #1, , INPUT.DATA$

                INPUT.VAL% = VAL(INPUT.DATA$)

                SELECT CASE INPUT.VAL%
                    CASE IS < MIN.VAL%
                        MIN.VAL% = INPUT.VAL%
                    CASE IS > MAX.VAL%
                        MAX.VAL% = INPUT.VAL%
                END SELECT

            LOOP WHILE NOT EOF(1)

            CLOSE #1
        NEXT

        LOCATE 12, 15
        PRINT SPACE$(55)
        LOCATE 12, 15
        PRINT " MAX ALTITUDE : "; STR$(MAX.VAL%); "    MIN ALTITUDE : "; STR$(MIN.VAL%); " "

    NEXT

    SLEEP 2

    ALTITUDE.RANGE% = MAX.VAL% - MIN.VAL%

    ALTITUDE.INC% = 20

    SELECT CASE ALTITUDE.RANGE%
        CASE IS > 5100
            ALTITUDE.INC% = 40
        CASE IS > 10200
            ALTITUDE.INC% = 60
        CASE IS > 15300
            ALTITUDE.INC% = 80
    END SELECT

    ROW.NO% = 0

    SCREEN 13
    CLS

TOP:

    MIN.COLOR% = 1
    MAX.COLOR% = 255
    GOSUB SHIFTER

    MAX.COLOR% = 0
    MIN.COLOR% = 255

    FOR LATITUDE% = INPUT.LAT% TO (INPUT.LAT% + 1)

        FILE.ROW% = 200 - (ROW.NO% * 120)
        ROW.NO% = ROW.NO% + 1
        COL.NO% = 0

        FOR LONGITUDE% = (INPUT.LONG% - 2) TO INPUT.LONG%

            FILE.COL% = (COL.NO% * 120) + 1
            COL.NO% = COL.NO% + 1

            FILE.LAT$ = LTRIM$(STR$(LATITUDE%))
            FILE.LONG$ = LTRIM$(STR$(LONGITUDE%))
            IF LONGITUDE% < 10 THEN
                FILE.LONG$ = "0" + FILE.LONG$
            END IF
            IF LONGITUDE% < 100 THEN
                FILE.LONG$ = "0" + FILE.LONG$
            END IF
            INPUT.FILE$ = FILE.LAT$ + FILE.LONG$ + ".30S"

            OPEN INPUT.FILE$ FOR BINARY AS #1

            INPUT.RECORD% = 0

            DO
                GOSUB KEYCHECK

                GET #1, , INPUT.DATA$

                INPUT.VAL% = VAL(INPUT.DATA$)

                CLR% = 255 - ABS(CINT((MIN.VAL% - INPUT.VAL%) / ALTITUDE.INC%) + 1)
                IF INPUT.VAL% = 0 THEN
                    CLR% = 0
                ELSE
                    IF CLR% < MIN.COLOR% THEN
                        MIN.COLOR% = CLR%
                    END IF
                END IF
                IF CLR% > MAX.COLOR% THEN
                    MAX.COLOR% = CLR%
                END IF

                ROW% = FILE.ROW% - (INT((INPUT.RECORD% / 120)))
                COL% = (INPUT.RECORD% MOD 120) + FILE.COL%

                IF ROW% > 0 AND ROW% < 199 AND COL% > 0 AND COL% < 319 THEN
                    PSET (COL%, ROW%), CLR%
                END IF

                INPUT.RECORD% = INPUT.RECORD% + 1

            LOOP WHILE NOT EOF(1)

            CLOSE #1

        NEXT

    NEXT

    CLOSE #2

    DO
        GOSUB KEYCHECK

        GOSUB SHIFTER

    LOOP

SHIFTER:

    RINC% = 1
    GINC% = 1
    BINC% = 1

    R% = INT(RND * 40) + 20
    G% = INT(RND * 40) + 20
    B% = INT(RND * 40) + 20

    FOR COLR% = MIN.COLOR% TO MAX.COLOR%
        R% = R% + RINC
        IF R% > 61 OR R% < 10 THEN
            RINC% = -RINC%
        END IF
        B% = B% + BINC%
        IF B% > 61 OR B% < 10 THEN
            BINC% = -BINC%
        END IF
        G% = G% + GINC%
        IF G% > 61 OR G% < 10 THEN
            GINC% = -GINC%
        END IF
        PALETTE COLR%, ((B% * BLUINC&) + (G% * GRNINC%) + (R% * REDINC%))
    NEXT

    RETURN

KEYCHECK:

    KY$ = INKEY$

    IF KY$ = CHR$(27) THEN
        SCREEN 0
        CLS
        SYSTEM
    END IF

    IF LEN(KY$) THEN

        SELECT CASE UCASE$(KY$)
            CASE "C"
                CLS
            CASE "P"
                WHILE INKEY$ = ""
                WEND
            CASE "R"
                GOTO TOP
            CASE "S"
                GOSUB SHIFTER
            CASE ELSE
        END SELECT

    END IF

    RETURN